home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / XML / XPath / Function.pm < prev    next >
Encoding:
Perl POD Document  |  2003-01-26  |  10.1 KB  |  393 lines
  1. # $Id: Function.pm,v 1.26 2002/12/26 17:24:50 matt Exp $
  2.  
  3. package XML::XPath::Function;
  4. use XML::XPath::Number;
  5. use XML::XPath::Literal;
  6. use XML::XPath::Boolean;
  7. use XML::XPath::NodeSet;
  8. use XML::XPath::Node::Attribute;
  9. use strict;
  10.  
  11. sub new {
  12.     my $class = shift;
  13.     my ($pp, $name, $params) = @_;
  14.     bless { 
  15.         pp => $pp, 
  16.         name => $name, 
  17.         params => $params 
  18.         }, $class;
  19. }
  20.  
  21. sub as_string {
  22.     my $self = shift;
  23.     my $string = $self->{name} . "(";
  24.     my $second;
  25.     foreach (@{$self->{params}}) {
  26.         $string .= "," if $second++;
  27.         $string .= $_->as_string;
  28.     }
  29.     $string .= ")";
  30.     return $string;
  31. }
  32.  
  33. sub as_xml {
  34.     my $self = shift;
  35.     my $string = "<Function name=\"$self->{name}\"";
  36.     my $params = "";
  37.     foreach (@{$self->{params}}) {
  38.         $params .= "<Param>" . $_->as_string . "</Param>\n";
  39.     }
  40.     if ($params) {
  41.         $string .= ">\n$params</Function>\n";
  42.     }
  43.     else {
  44.         $string .= " />\n";
  45.     }
  46.     
  47.     return $string;
  48. }
  49.  
  50. sub evaluate {
  51.     my $self = shift;
  52.     my $node = shift;
  53.     if ($node->isa('XML::XPath::NodeSet')) {
  54.         $node = $node->get_node(1);
  55.     }
  56.     my @params;
  57.     foreach my $param (@{$self->{params}}) {
  58.         my $results = $param->evaluate($node);
  59.         push @params, $results;
  60.     }
  61.     $self->_execute($self->{name}, $node, @params);
  62. }
  63.  
  64. sub _execute {
  65.     my $self = shift;
  66.     my ($name, $node, @params) = @_;
  67.     $name =~ s/-/_/g;
  68.     no strict 'refs';
  69.     $self->$name($node, @params);
  70. }
  71.  
  72. # All functions should return one of:
  73. # XML::XPath::Number
  74. # XML::XPath::Literal (string)
  75. # XML::XPath::NodeSet
  76. # XML::XPath::Boolean
  77.  
  78. ### NODESET FUNCTIONS ###
  79.  
  80. sub last {
  81.     my $self = shift;
  82.     my ($node, @params) = @_;
  83.     die "last: function doesn't take parameters\n" if (@params);
  84.     return XML::XPath::Number->new($self->{pp}->get_context_size);
  85. }
  86.  
  87. sub position {
  88.     my $self = shift;
  89.     my ($node, @params) = @_;
  90.     if (@params) {
  91.         die "position: function doesn't take parameters [ ", @params, " ]\n";
  92.     }
  93.     # return pos relative to axis direction
  94.     return XML::XPath::Number->new($self->{pp}->get_context_pos);
  95. }
  96.  
  97. sub count {
  98.     my $self = shift;
  99.     my ($node, @params) = @_;
  100.     die "count: Parameter must be a NodeSet\n" unless $params[0]->isa('XML::XPath::NodeSet');
  101.     return XML::XPath::Number->new($params[0]->size);
  102. }
  103.  
  104. sub id {
  105.     my $self = shift;
  106.     my ($node, @params) = @_;
  107.     die "id: Function takes 1 parameter\n" unless @params == 1;
  108.     my $results = XML::XPath::NodeSet->new();
  109.     if ($params[0]->isa('XML::XPath::NodeSet')) {
  110.         # result is the union of applying id() to the
  111.         # string value of each node in the nodeset.
  112.         foreach my $node ($params[0]->get_nodelist) {
  113.             my $string = $node->string_value;
  114.             $results->append($self->id($node, XML::XPath::Literal->new($string)));
  115.         }
  116.     }
  117.     else { # The actual id() function...
  118.         my $string = $self->string($node, $params[0]);
  119.         $_ = $string->value; # get perl scalar
  120.         my @ids = split; # splits $_
  121.         foreach my $id (@ids) {
  122.             if (my $found = $node->getElementById($id)) {
  123.                 $results->push($found);
  124.             }
  125.         }
  126.     }
  127.     return $results;
  128. }
  129.  
  130. sub local_name {
  131.     my $self = shift;
  132.     my ($node, @params) = @_;
  133.     if (@params > 1) {
  134.         die "name() function takes one or no parameters\n";
  135.     }
  136.     elsif (@params) {
  137.         my $nodeset = shift(@params);
  138.         $node = $nodeset->get_node(1);
  139.     }
  140.     
  141.     return XML::XPath::Literal->new($node->getLocalName);
  142. }
  143.  
  144. sub namespace_uri {
  145.     my $self = shift;
  146.     my ($node, @params) = @_;
  147.     die "namespace-uri: Function not supported\n";
  148. }
  149.  
  150. sub name {
  151.     my $self = shift;
  152.     my ($node, @params) = @_;
  153.     if (@params > 1) {
  154.         die "name() function takes one or no parameters\n";
  155.     }
  156.     elsif (@params) {
  157.         my $nodeset = shift(@params);
  158.         $node = $nodeset->get_node(1);
  159.     }
  160.     
  161.     return XML::XPath::Literal->new($node->getName);
  162. }
  163.  
  164. ### STRING FUNCTIONS ###
  165.  
  166. sub string {
  167.     my $self = shift;
  168.     my ($node, @params) = @_;
  169.     die "string: Too many parameters\n" if @params > 1;
  170.     if (@params) {
  171.         return XML::XPath::Literal->new($params[0]->string_value);
  172.     }
  173.     
  174.     # TODO - this MUST be wrong! - not sure now. -matt
  175.     return XML::XPath::Literal->new($node->string_value);
  176.     # default to nodeset with just $node in.
  177. }
  178.  
  179. sub concat {
  180.     my $self = shift;
  181.     my ($node, @params) = @_;
  182.     die "concat: Too few parameters\n" if @params < 2;
  183.     my $string = join('', map {$_->string_value} @params);
  184.     return XML::XPath::Literal->new($string);
  185. }
  186.  
  187. sub starts_with {
  188.     my $self = shift;
  189.     my ($node, @params) = @_;
  190.     die "starts-with: incorrect number of params\n" unless @params == 2;
  191.     my ($string1, $string2) = ($params[0]->string_value, $params[1]->string_value);
  192.     if (substr($string1, 0, length($string2)) eq $string2) {
  193.         return XML::XPath::Boolean->True;
  194.     }
  195.     return XML::XPath::Boolean->False;
  196. }
  197.  
  198. sub contains {
  199.     my $self = shift;
  200.     my ($node, @params) = @_;
  201.     die "starts-with: incorrect number of params\n" unless @params == 2;
  202.     my $value = $params[1]->string_value;
  203.     if ($params[0]->string_value =~ /(.*?)\Q$value\E(.*)/) {
  204.         # $1 and $2 stored for substring funcs below
  205.         # TODO: Fix this nasty implementation!
  206.         return XML::XPath::Boolean->True;
  207.     }
  208.     return XML::XPath::Boolean->False;
  209. }
  210.  
  211. sub substring_before {
  212.     my $self = shift;
  213.     my ($node, @params) = @_;
  214.     die "starts-with: incorrect number of params\n" unless @params == 2;
  215.     if ($self->contains($node, @params)->value) {
  216.         return XML::XPath::Literal->new($1); # hope that works!
  217.     }
  218.     else {
  219.         return XML::XPath::Literal->new('');
  220.     }
  221. }
  222.  
  223. sub substring_after {
  224.     my $self = shift;
  225.     my ($node, @params) = @_;
  226.     die "starts-with: incorrect number of params\n" unless @params == 2;
  227.     if ($self->contains($node, @params)->value) {
  228.         return XML::XPath::Literal->new($2);
  229.     }
  230.     else {
  231.         return XML::XPath::Literal->new('');
  232.     }
  233. }
  234.  
  235. sub substring {
  236.     my $self = shift;
  237.     my ($node, @params) = @_;
  238.     die "substring: Wrong number of parameters\n" if (@params < 2 || @params > 3);
  239.     my ($str, $offset, $len);
  240.     $str = $params[0]->string_value;
  241.     $offset = $params[1]->value;
  242.     $offset--; # uses 1 based offsets
  243.     if (@params == 3) {
  244.         $len = $params[2]->value;
  245.     }
  246.     return XML::XPath::Literal->new(substr($str, $offset, $len));
  247. }
  248.  
  249. sub string_length {
  250.     my $self = shift;
  251.     my ($node, @params) = @_;
  252.     die "string-length: Wrong number of params\n" if @params > 1;
  253.     if (@params) {
  254.         return XML::XPath::Number->new(length($params[0]->string_value));
  255.     }
  256.     else {
  257.         return XML::XPath::Number->new(
  258.                 length($node->string_value)
  259.                 );
  260.     }
  261. }
  262.  
  263. sub normalize_space {
  264.     my $self = shift;
  265.     my ($node, @params) = @_;
  266.     die "normalize-space: Wrong number of params\n" if @params > 1;
  267.     my $str;
  268.     if (@params) {
  269.         $str = $params[0]->string_value;
  270.     }
  271.     else {
  272.         $str = $node->string_value;
  273.     }
  274.     $str =~ s/^\s*//;
  275.     $str =~ s/\s*$//;
  276.     $str =~ s/\s+/ /g;
  277.     return XML::XPath::Literal->new($str);
  278. }
  279.  
  280. sub translate {
  281.     my $self = shift;
  282.     my ($node, @params) = @_;
  283.     die "translate: Wrong number of params\n" if @params != 3;
  284.     local $_ = $params[0]->string_value;
  285.     my $find = $params[1]->string_value;
  286.     my $repl = $params[2]->string_value;
  287.     eval "tr/\\Q$find\\E/\\Q$repl\\E/d, 1" or die $@;
  288.     return XML::XPath::Literal->new($_);
  289. }
  290.  
  291. ### BOOLEAN FUNCTIONS ###
  292.  
  293. sub boolean {
  294.     my $self = shift;
  295.     my ($node, @params) = @_;
  296.     die "boolean: Incorrect number of parameters\n" if @params != 1;
  297.     return $params[0]->to_boolean;
  298. }
  299.  
  300. sub not {
  301.     my $self = shift;
  302.     my ($node, @params) = @_;
  303.     $params[0] = $params[0]->to_boolean unless $params[0]->isa('XML::XPath::Boolean');
  304.     $params[0]->value ? XML::XPath::Boolean->False : XML::XPath::Boolean->True;
  305. }
  306.  
  307. sub true {
  308.     my $self = shift;
  309.     my ($node, @params) = @_;
  310.     die "true: function takes no parameters\n" if @params > 0;
  311.     XML::XPath::Boolean->True;
  312. }
  313.  
  314. sub false {
  315.     my $self = shift;
  316.     my ($node, @params) = @_;
  317.     die "true: function takes no parameters\n" if @params > 0;
  318.     XML::XPath::Boolean->False;
  319. }
  320.  
  321. sub lang {
  322.     my $self = shift;
  323.     my ($node, @params) = @_;
  324.     die "lang: function takes 1 parameter\n" if @params != 1;
  325.     my $lang = $node->findvalue('(ancestor-or-self::*[@xml:lang]/@xml:lang)[last()]');
  326.     my $lclang = lc($params[0]->string_value);
  327.     # warn("Looking for lang($lclang) in $lang\n");
  328.     if (substr(lc($lang), 0, length($lclang)) eq $lclang) {
  329.         return XML::XPath::Boolean->True;
  330.     }
  331.     else {
  332.         return XML::XPath::Boolean->False;
  333.     }
  334. }
  335.  
  336. ### NUMBER FUNCTIONS ###
  337.  
  338. sub number {
  339.     my $self = shift;
  340.     my ($node, @params) = @_;
  341.     die "number: Too many parameters\n" if @params > 1;
  342.     if (@params) {
  343.         if ($params[0]->isa('XML::XPath::Node')) {
  344.             return XML::XPath::Number->new(
  345.                     $params[0]->string_value
  346.                     );
  347.         }
  348.         return $params[0]->to_number;
  349.     }
  350.     
  351.     return XML::XPath::Number->new( $node->string_value );
  352. }
  353.  
  354. sub sum {
  355.     my $self = shift;
  356.     my ($node, @params) = @_;
  357.     die "sum: Parameter must be a NodeSet\n" unless $params[0]->isa('XML::XPath::NodeSet');
  358.     my $sum = 0;
  359.     foreach my $node ($params[0]->get_nodelist) {
  360.         $sum += $self->number($node)->value;
  361.     }
  362.     return XML::XPath::Number->new($sum);
  363. }
  364.  
  365. sub floor {
  366.     my $self = shift;
  367.     my ($node, @params) = @_;
  368.     require POSIX;
  369.     my $num = $self->number($node, @params);
  370.     return XML::XPath::Number->new(
  371.             POSIX::floor($num->value));
  372. }
  373.  
  374. sub ceiling {
  375.     my $self = shift;
  376.     my ($node, @params) = @_;
  377.     require POSIX;
  378.     my $num = $self->number($node, @params);
  379.     return XML::XPath::Number->new(
  380.             POSIX::ceil($num->value));
  381. }
  382.  
  383. sub round {
  384.     my $self = shift;
  385.     my ($node, @params) = @_;
  386.     my $num = $self->number($node, @params);
  387.     require POSIX;
  388.     return XML::XPath::Number->new(
  389.             POSIX::floor($num->value + 0.5)); # Yes, I know the spec says don't do this...
  390. }
  391.  
  392. 1;
  393.